PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/oopmous.com/MOUSEUNI.PAS

Pascal/Delphi Source File | 1989-11-01 | 8.1 KB | 295 lines

{$I mouseuni.inc}

const
    MOUSE_DRIVER_INTERRUPT = $33;
var
    mouse_exists : boolean;
    mouse_visible : boolean;
    mouse_buttons : integer;
    Registers : DOS.Registers;

{ --------------------------------------------------------------------- }

procedure CallMouse(MouseFunction : integer);
begin
    Registers.AX := MouseFunction;
    intr (MOUSE_DRIVER_INTERRUPT, Registers);
end; { CallMouse }

{ --------------------------------------------------------------------- }

function mouse_object.Exists : boolean;
{ check if a mouse driver is currently loaded                }
begin
    Exists := mouse_exists;
end;

{ --------------------------------------------------------------------- }

function mouse_object.NumberOfButtons : integer;
{ returns the number of available buttons on the mouse            }
begin
    NumberOfButtons := mouse_buttons;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Reset;
{ reset the mouse driver to its defaults                }
begin
    CallMouse(0);
    Mouse_Exists := Registers.AX <> 0;
end; { Reset }

{ --------------------------------------------------------------------- }

procedure mouse_object.Show;
{ Makes the mouse cursor visible.                    }
begin
    if mouse_visible then exit;
    CallMouse(1);
    mouse_visible := true;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Hide;
{ Makes mouse cursor invisible. Movement and button activity are    }
{ still tracked.                            }
begin
    if not mouse_visible then exit;
    CallMouse(2);
    mouse_visible := false;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.GetStatus(var status, row, column : integer);
{ Gets mouse cursor position and button status.                }
begin
    CallMouse (3);
    with Registers do begin
        column := CX;
        row := DX;
        status := BX;
    end;
end; { GetPosition }

{ --------------------------------------------------------------------- }

procedure mouse_object.MoveTo(new_row, new_column : integer);
{ Move mouse cursor to new position                    }
begin
    with Registers do begin
        CX := new_column;
        DX := new_row;
    end;
    CallMouse(4);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Pressed(button : integer; var result : boolean; var count, row, column : integer);
{ Gets pressed info about named button: current status (up/down),    }
{ times pressed since last call, position at most recent press.        }
{ Resets count and position info. Button 0 is left, 1 is right on    }
{ Microsoft mouse.                            }
begin
    with Registers do begin
        BX := button - 1;
        CallMouse(5);
        case button of
            1 : result := AX and $01 <> 0;
            2 : result := AX and $02 <> 0;
            3 : result := AX and $04 <> 0;
        end; { case }
        count := BX;
        column := CX;
        row := DX;
    end; { with }
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Released(button : integer; var result : boolean; var count, row, column : integer);
{ Gets released info about named button: current status (up/down),    }
{ times released since last call, position at most recent press.    }
{ Resets count and position info. Button 0 is left, 1 is right on    }
{ Microsoft mouse.                            }
begin
    with Registers do begin
        BX := button - 1;
        CallMouse(6);
        case button of
            1 : result := AX and $01 <> 0;
            2 : result := AX and $02 <> 0;
            3 : result := AX and $04 <> 0;
        end; { case }
        count := BX;
        column := CX;
        row := DX;
    end; { with }
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.ColRange(horizontal_min, horizontal_max : integer);
{ Sets min and max horizontal range for mouse cursor. Moves        }
{ cursor inside range if outside when called. Swaps values if        }
{ min and max are reversed.                        }
begin
    with Registers do begin
        CX := horizontal_min;
        DX := horizontal_max;
    end; { with }
    CallMouse(7);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.RowRange(vertical_min, vertical_max : integer);
{ Sets min and max vertical range for mouse cursor. Moves        }
{ cursor inside range if outside when called. Swaps values if        }
{ min and max are reversed.                        }
begin
    with Registers do begin
        CX := vertical_min;
        DX := vertical_max;
    end; { with }
    CallMouse(8);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.GraphCursor(hHot, vHot : integer; mask_segment, mask_offset : word);
{ Sets graphic cursor shape                        }
begin
    with Registers do begin
        BX := hHot;
        CX := vHot;
        DX := mask_offset;
        ES := mask_segment;
    end;
    CallMouse(9);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.TextCursor(cursor_type : integer; arg1, arg2 : word);
{ Sets text cursor type, where 0 = software and 1 = hardware)        }
{ For software cursor, arg1 and arg2 are the screen and cursor        }
{ masks.  For hardware cursor, arg1 and arg2 specify scan line        }
{ start/stop i.e. cursor shape.                        }
begin
    with Registers do begin
        BX := cursor_type;
        CX := arg1;
        DX := arg2;
    end;
    CallMouse(10);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Motion(var horizontal_count, vertical_count : integer);
{ Reports net motion of cursor since last call to this function        }
begin
    CallMouse(11);
    with Registers do begin
        horizontal_count := CX;
        vertical_count := DX;
    end;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.InstallTask(mask, task_segment, task_offset : word);
{ Installs a user-defined task to be executed upon one or more        }
{   mouse events specified by mask.                    }
begin
    with Registers do begin
        CX := mask;
        DX := task_offset;
        ES := task_segment;
    end;
    CallMouse(12);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.LightPenOn;
{ Turns on light pen emulation. This is the default condition.        }
begin
    CallMouse(13);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.LightPenOff;
{ Turns off light pen emulation.                    }
begin
    CallMouse(14);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.Ratio(horizontal, vertical : integer);
{ Sets mickey-to-pixel ratio, where ratio is R/8. Default is 16        }
{   for vertical, 8 for horizontal                    }
begin
    with Registers do begin
        CX := horizontal;
        DX := vertical;
    end;
    CallMouse(15);
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.ConditionOff(x1, y1, x2, y2 : integer);
{ This function hides the mouse if it is in the region when this    }
{ function is called.  Afterwards your program must call Show to show    }
{ the cursor again.                            }
begin
    if not mouse_visible then exit;
    with Registers do begin
        SI := x2;        { lower x screen coordinates    }
        DI := y2;        { lower y screen coordinates    }
        CX := x1;        { upper x screen coordinates    }
        DX := y1;        { upper y screen coordinates    }
    end;
    CallMouse(16);
    mouse_visible := false;
end;

{ --------------------------------------------------------------------- }

procedure mouse_object.SetThreshold(x : integer);
{ Set the threshold speed for doubling the cursor's movements        }
begin
    Registers.DX := x;
    CallMouse(19);
end;


{ --------------------------------------------------------------------- }

var    ExitSave: pointer;        { Previous exit procedure    }

{$F+} procedure ExitHandler; {$F-}
begin
    ExitProc := ExitSave;    { Chain to other exit procedures    }
    CallMouse(0);
end;

{ --------------------------------------------------------------------- }

begin
    ExitSave := ExitProc;
    ExitProc := @ExitHandler;    { Install our exit procedure    }
    CallMouse(0);
    mouse_exists := Registers.AX <> 0;
    mouse_visible := false;
    mouse_buttons := Registers.BX;
end.